package Users;

use strict;
use warnings;
use diagnostics;
use Carp;
use DBI;
use Readonly;

Readonly(my $CRYPT_SALT => 'skal-user-password');

sub new {
    my $class_name = shift;

    my $self = bless {}, $class_name;
    $self->{dbh} = DBI->connect(
        "dbi:SQLite:dbname=$ENV{SKAL_ROOT}/db/skaldb.sqlite3",
        q{},
        q{},
        {RaiseError => 1}
    ) or die $DBI::errstr;
    return $self;
}

# Command / action
sub add {
    my $self     = shift;
    my $username = shift // croak('Missing username scalar string parameter');
    my $password = shift // croak('Missing password scalar string parameter');

    $password = crypt $password, $CRYPT_SALT;
    my $rv = $self->{dbh}->do(
        "insert into users (name, password) values ('$username', '$password');"
    ) or die $DBI::errstr;
    die $DBI::errstr if ($rv < 0);
    return $rv;
}

# Command / action
sub del {
    my $self = shift;
    my $user = shift // croak('Missing username scalar string parameter');

    my $rv = $self->{dbh}->do(
        "delete from users where name = '$user';"
    ) or die $DBI::errstr;
    die $DBI::errstr if ($rv < 0);
    return $rv;
}

# Command / action
sub pass {
    my $self     = shift;
    my $username = shift // croak('Missing username scalar string parameter');
    my $password = shift // croak('Missing password scalar string parameter');

    $password = crypt $password, $CRYPT_SALT;
    my $rv = $self->{dbh}->do(
        "update users set password = '$password' where name = '$username';"
    ) or die $DBI::errstr;
    die $DBI::errstr if ($rv < 0);
    return $rv;
}

# Command / action
sub help {
    my $self = shift;

    return <<END_OF_HELP_MSG;
Known actions / commands are:

add    - add new user and password
del    - delete existing user
help   - show this help message
list   - list all user names
pass   - set new password for existing user
END_OF_HELP_MSG
}

# Command / action
sub list {
    my $self = shift;

    my $sth = $self->{dbh}->prepare('select name from users order by name asc;');
    my $rv  = $sth->execute or die $DBI::errstr;
    die $DBI::errstr if ($rv < 0);
    my $ret_str;
    my $counter = 0;
    foreach my $arrref (@{$sth->fetchall_arrayref}) {
        $ret_str .= "$arrref->[0]\n";
        ++$counter;
    }
    if (! $ret_str && $counter == 0) {
        return "There are no users in the database!\n";
    }
    return $ret_str . "-> Total number of users: $counter\n";
}

sub user_exists {
    my $self = shift;
    my $user = shift // croak('Missing username scalar string parameter');

    if ($user =~ /[\W\s]/ || $user =~ /(?:_{2,})+/) {
        return -1;
    }
    # User name can contain only alphanumeric characters plus _ character
    # To defence against SQL injection
    my $sth = $self->{dbh}->prepare("select name from users where name = '$user';");
    my $rv  = $sth->execute or die $DBI::errstr;
    die $DBI::errstr if ($rv < 0);
    return scalar @{$sth->fetchall_arrayref};
}

sub disconnect {
    my $self = shift;

    $self->{dbh}->disconnect or die $DBI::errstr;
    return 1;
}

1;

__END__

=pod

=head1 About

This file contains a module for easier manipulation with Skal's user database.
Its purpose is to be accessible on server where user can log in via SSH and
then run script which uses this module for manipulating with Skal's user
database, or just run the script which uses this module on localhost and after
some changes load the SQLite database file on server.

=head1 Methods

=head2 new

Creates a new instance of Users class and establishes connection to SQLite
database file. Returns the object reference, as is customary.

=head2 add

Adds new user and its password to the database. Takes two mandatory
parameters, new user name (scalar string) and new user's password (scalar
string). The password is crypted by Perl C<crypt> function. Returns the number
of affected rows (1).

Don't forget to check if username is valid and if it already exists by
C<< ->user_exists($test_username) >> method, description is below.

=head2 del

Deletes row with defined username which is taken as a mandatory parameter
(scalar string) from a database. Returns the number of affected rows (1).

Don't forget to check if username is valid and if it already exists by
C<< ->user_exists($test_username) >> method, description is below.

=head2 pass

Changes user's password. Existing username (scalar string) and new password
(scalar string) are taken as a mandatory parameters. The new password is
crypted by Perl C<crypt> function. Returns the number of affected rows (1).

Don't forget to check if username is valid and if it already exists by
C<< ->user_exists($test_username) >> method, description is below.

=head2 help

Shows brief help message containing list of known actions / commands and their
description.

=head2 list

Returns a list of usernames and their total number at the end of output.

=head2 user_exists

Takes one mandatory parameter which is the name of the user we want to test if
it exists or not, or if it does or does not contain some unauthorized
characters. Allowed characters are all alphanumeric characters and a
C<_> character, but not two or more C<_> characters in a row. Returns:

=over

=item -1

if username contains unauthorized characters (see above)

=item 0

if username does not exist in database

=item 1

if username exists in database

=back

=head2 disconnect

Disconnects the connection to database. Returns true value (1).

